home *** CD-ROM | disk | FTP | other *** search
- {
- =+= Copyright 1993 By M. Murat DiCLE
- =+= Print Screen Manager
- }
-
- {$M 4096,0,0}
- Uses Crt, Dos;
- Var
- PrintScreen:Procedure;
- P :Pointer;
- I :Integer;
- EkrMem:LongInt;
- Busy :Boolean;
- Attr :Byte;
- X, Y :Byte;
- C :Char;
- FN :String;
- F :File;
-
- {$F+}
-
- Procedure EkranAl;
- Begin
- For I := 0 To 3999 Do
- Mem[EkrMem:4000+I] := Mem[EkrMem:I]
- End;
-
- Procedure EkranGetir;
- Begin
- For I := 0 To 3999 Do
- Mem[EkrMem:I] := Mem[EkrMem:4000+I]
- End;
- Procedure PrtScrManager; Interrupt;
- Begin
- If Busy Then Exit;
- Busy := TRUE;
- Attr := TextAttr;
- X := WhereX;
- Y := WhereY;
- { Ekran Baslangic adresi belirleniyor.}
- If LastMode = 7 Then
- EkrMem := $B000
- Else
- EkrMem := $B800;
- EkranAl;
- TextColor(0);
- TextBackGround(7);
- GotoXY(1, 25);
- Write('1-BAS');
- Write('2-SAKLA':12);
- Write('3-ÿPTAL':12);
- Write('PrtScr Manager (c) 1993 M.M.D.':40);
- ClrEol;
- Repeat
- C := ReadKey
- Until C In['1'..'3'];
- EkranGetir;
- Case C Of
- '1' : Begin
- InLine($9C);
- PrintScreen
- End;
- '2' : Begin
- GotoXY(1, 25);
- Write('Dosya adì:');
- ClrEol;
- GotoXY(12, 25); ReadLn(FN);
- EkranGetir;
- If FN <> '' Then
- Begin
- Assign(F, FN);
- ReWrite(F, 1);
- BlockWrite(F, Mem[EkrMem:0], 4000);
- Close(F)
- End
- End;
- End;
- TextAttr := Attr;
- GotoXY(X, Y);
- Busy := FALSE;
- End;
- {$F-}
-
- Begin
- WriteLn('=+= Print Screen Manager =+=');
- GetIntVec(100, P);
- If P <> Nil Then
- Begin
- WriteLn('Program zaten aktif halde!');
- WriteLn('PRINT SCREEN tuƒuna basìnìz...'#7);
- Halt
- End;
- SetIntVec(100, @PrtScrManager);
- GetIntVec(5, @PrintScreen);
- SetIntVec(5, @PrtScrManager);
- WriteLn('Program aktif halde!');
- WriteLn('PRINT SCREEN tuƒuna basìnìz...');
- Busy := False;
- Keep(0);
- End.